indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.3 v dplyr 1.0.7
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 2.0.0 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 443)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 12.93747 12.93674 12.93600 12.93525 12.93450 12.93374 12.93298 12.93222
## [9] 12.93145 12.93069 12.92993 12.92917 12.92842 12.92768 12.92695 12.92623
## [17] 12.92551 12.92482 12.92413 12.92347 12.92282 12.92219 12.92159 12.92100
## [25] 12.92044 12.91991 12.91940 12.91893 12.91848 12.91806 12.91768 12.91734
## [33] 12.91703 12.91676 12.91652 12.91633 12.91619 12.91608 12.91603 12.91602
## [41] 12.91605 12.91614 12.91629 12.91648 12.91674 12.91706 12.91742 12.91784
## [49] 12.91831 12.91883 12.91940 12.92001 12.92066 12.92136 12.92209 12.92286
## [57] 12.92366 12.92449 12.92536 12.92625 12.92717 12.92811 12.92908 12.93006
## [65] 12.93107 12.93209 12.93312 12.93417 12.93522 12.93629 12.93736 12.93843
## [73] 12.93951 12.94058 12.94166 12.94273 12.94379 12.94485 12.94589 12.94693
## [81] 12.94794 12.94895 12.94993 12.95089 12.95184 12.95275 12.95364 12.95451
## [89] 12.95534 12.95614 12.95690 12.95763 12.95841 12.95933 12.96038 12.96155
## [97] 12.96283 12.96423 12.96573 12.96732 12.96900 12.97076 12.97259 12.97449
## [105] 12.97645 12.97846 12.98052 12.98262 12.98475 12.98690 12.98907 12.99125
## [113] 12.99343 12.99561 12.99778 12.99993 13.00206 13.00415 13.00620 13.00821
## [121] 13.01017 13.01206 13.01389 13.01565 13.01732 13.01891 13.02040 13.02178
## [129] 13.02306 13.02422 13.02526 13.02617 13.02694 13.02756 13.02804 13.02890
## [137] 13.03065 13.03317 13.03639 13.04020 13.04450 13.04921 13.05423 13.05946
## [145] 13.06481 13.07018 13.07549 13.08062 13.08550 13.09002 13.09409 13.09761
## [153] 13.10050 13.10265 13.10397 13.10436 13.10462 13.10555 13.10710 13.10924
## [161] 13.11190 13.11503 13.11859 13.12253 13.12680 13.13134 13.13610 13.14105
## [169] 13.14612 13.15126 13.15644 13.16159 13.16666 13.17161 13.17639 13.18095
## [177] 13.18523 13.18919 13.19278 13.19594 13.19863 13.20080 13.20239 13.20336
## [185] 13.20366 13.20324 13.20204 13.20002 13.19713 13.19331 13.18858 13.18302
## [193] 13.17668 13.16964 13.16196 13.15370 13.14492 13.13570 13.12611 13.11619
## [201] 13.10603 13.09568 13.08521 13.07469 13.06418 13.05374 13.04345 13.03337
## [209] 13.02356 13.01409 13.00502 12.99643 12.98743 12.97720 12.96582 12.95337
## [217] 12.93994 12.92563 12.91052 12.89471 12.87827 12.86130 12.84389 12.82613
## [225] 12.80810 12.78989 12.77160 12.75331 12.73510 12.71708 12.69932 12.68192
## [233] 12.66496 12.64854 12.63274 12.61765 12.60336 12.58996 12.57628 12.56120
## [241] 12.54485 12.52738 12.50894 12.48965 12.46967 12.44912 12.42817 12.40694
## [249] 12.38557 12.36421 12.34301 12.32209 12.30161 12.28169 12.26250 12.24415
## [257] 12.22681 12.21060 12.19567 12.18127 12.16658 12.15164 12.13649 12.12115
## [265] 12.10568 12.09011 12.07447 12.05880 12.04315 12.02754 12.01203 11.99663
## [273] 11.98140 11.96637 11.95158 11.93706 11.92286 11.90901 11.89554 11.88250
## [281] 11.86993 11.85785 11.84615 11.83465 11.82335 11.81227 11.80140 11.79074
## [289] 11.78030 11.77008 11.76008 11.75030 11.74075 11.73142 11.72231 11.71344
## [297] 11.70480 11.69639 11.68822 11.68028 11.67258 11.66513 11.65792 11.65051
## [305] 11.64250 11.63398 11.62502 11.61568 11.60604 11.59618 11.58616 11.57607
## [313] 11.56597 11.55594 11.54604 11.53636 11.52697 11.51794 11.50935 11.50125
## [321] 11.49374 11.48689 11.48076 11.47543 11.47097 11.46746 11.46497 11.46357
## [329] 11.46334 11.46383 11.46458 11.46559 11.46686 11.46841 11.47025 11.47238
## [337] 11.47482 11.47757 11.48065 11.48405 11.48779 11.49189 11.49634 11.50116
## [345] 11.50636 11.51194 11.51792 11.52430 11.53109 11.53830 11.54596 11.55405
## [353] 11.56258 11.57154 11.58090 11.59066 11.60081 11.61135 11.62225 11.63351
## [361] 11.64512 11.65706 11.66933 11.68192 11.69481 11.70799 11.72146 11.73520
## [369] 11.74921 11.76347 11.77796 11.79269 11.80764 11.82280 11.83816 11.85370
## [377] 11.86943 11.88531 11.90142 11.91781 11.93448 11.95144 11.96868 11.98622
## [385] 12.00405 12.02218 12.04061 12.05934 12.07838 12.09772 12.11738 12.13735
## [393] 12.15764 12.17825 12.19918 12.22044 12.24203 12.26395 12.28621 12.30879
## [401] 12.33168 12.35489 12.37840 12.40223 12.42636 12.45081 12.47556 12.50063
## [409] 12.52600 12.55167 12.57766 12.60395 12.63055 12.65745 12.68465 12.71216
## [417] 12.73997 12.76808 12.79650 12.82522 12.85424 12.88355 12.91315 12.94301
## [425] 12.97313 13.00352 13.03418 13.06511 13.09632 13.12781 13.15958 13.19163
## [433] 13.22398 13.25661 13.28954 13.32276 13.35629 13.39012 13.42426 13.45871
## [441] 13.49347 13.52854 13.56394#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log10 SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 443)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.44748 12.44956 12.45163 12.45367 12.45571 12.45774 12.45976 12.46177
## [9] 12.46378 12.46579 12.46780 12.46981 12.47183 12.47385 12.47588 12.47792
## [17] 12.47997 12.48204 12.48412 12.48622 12.48835 12.49049 12.49266 12.49485
## [25] 12.49708 12.49933 12.50162 12.50394 12.50629 12.50869 12.51113 12.51360
## [33] 12.51613 12.51870 12.52132 12.52398 12.52670 12.52948 12.53231 12.53520
## [41] 12.53815 12.54117 12.54424 12.54739 12.55059 12.55386 12.55718 12.56056
## [49] 12.56399 12.56747 12.57101 12.57458 12.57821 12.58187 12.58557 12.58931
## [57] 12.59309 12.59690 12.60073 12.60460 12.60849 12.61241 12.61634 12.62030
## [65] 12.62427 12.62825 12.63225 12.63625 12.64027 12.64429 12.64831 12.65233
## [73] 12.65635 12.66036 12.66437 12.66837 12.67236 12.67633 12.68029 12.68423
## [81] 12.68815 12.69205 12.69592 12.69977 12.70358 12.70736 12.71111 12.71483
## [89] 12.71850 12.72213 12.72572 12.72926 12.73291 12.73678 12.74089 12.74520
## [97] 12.74971 12.75440 12.75927 12.76430 12.76947 12.77478 12.78021 12.78574
## [105] 12.79137 12.79709 12.80287 12.80871 12.81459 12.82050 12.82644 12.83237
## [113] 12.83830 12.84421 12.85009 12.85592 12.86169 12.86738 12.87300 12.87852
## [121] 12.88392 12.88920 12.89435 12.89935 12.90419 12.90885 12.91332 12.91760
## [129] 12.92166 12.92550 12.92909 12.93244 12.93552 12.93889 12.94305 12.94792
## [137] 12.95340 12.95939 12.96582 12.97259 12.97961 12.98678 12.99403 13.00125
## [145] 13.00835 13.01526 13.02187 13.02809 13.03384 13.03902 13.04355 13.04732
## [153] 13.05026 13.05228 13.05407 13.05638 13.05916 13.06237 13.06595 13.06985
## [161] 13.07402 13.07842 13.08300 13.08770 13.09249 13.09730 13.10210 13.10683
## [169] 13.11144 13.11588 13.12012 13.12409 13.12774 13.13104 13.13392 13.13635
## [177] 13.13827 13.13963 13.14039 13.14049 13.13989 13.13854 13.13640 13.13350
## [185] 13.12987 13.12558 13.12065 13.11513 13.10907 13.10251 13.09548 13.08804
## [193] 13.08023 13.07209 13.06366 13.05499 13.04612 13.03710 13.02796 13.01875
## [201] 13.00951 13.00030 12.99114 12.98208 12.97317 12.96445 12.95597 12.94776
## [209] 12.93987 12.93234 12.92407 12.91401 12.90233 12.88917 12.87470 12.85906
## [217] 12.84242 12.82492 12.80673 12.78800 12.76887 12.74952 12.73009 12.71074
## [225] 12.69162 12.67289 12.65470 12.63721 12.62058 12.60495 12.59049 12.57735
## [233] 12.56568 12.55424 12.54177 12.52837 12.51415 12.49920 12.48364 12.46758
## [241] 12.45111 12.43434 12.41738 12.40033 12.38330 12.36640 12.34972 12.33338
## [249] 12.31747 12.30211 12.28741 12.27345 12.26036 12.24824 12.23681 12.22571
## [257] 12.21494 12.20446 12.19426 12.18431 12.17459 12.16509 12.15578 12.14663
## [265] 12.13764 12.12877 12.12001 12.11134 12.10273 12.09417 12.08562 12.07708
## [273] 12.06852 12.05991 12.05125 12.04250 12.03365 12.02467 12.01554 12.00625
## [281] 11.99710 11.98840 11.98012 11.97223 11.96470 11.95751 11.95062 11.94401
## [289] 11.93765 11.93151 11.92556 11.91977 11.91412 11.90857 11.90310 11.89769
## [297] 11.89229 11.88688 11.88144 11.87593 11.87033 11.86461 11.85874 11.85233
## [305] 11.84506 11.83703 11.82833 11.81903 11.80924 11.79903 11.78851 11.77774
## [313] 11.76683 11.75586 11.74493 11.73411 11.72349 11.71317 11.70324 11.69377
## [321] 11.68487 11.67661 11.66909 11.66239 11.65661 11.65183 11.64813 11.64561
## [329] 11.64436 11.64370 11.64293 11.64209 11.64122 11.64036 11.63956 11.63885
## [337] 11.63829 11.63790 11.63774 11.63785 11.63826 11.63902 11.64018 11.64177
## [345] 11.64383 11.64641 11.64955 11.65329 11.65768 11.66275 11.66836 11.67433
## [353] 11.68066 11.68734 11.69436 11.70171 11.70940 11.71740 11.72573 11.73435
## [361] 11.74328 11.75251 11.76202 11.77181 11.78188 11.79221 11.80281 11.81365
## [369] 11.82475 11.83608 11.84765 11.85944 11.87145 11.88368 11.89611 11.90873
## [377] 11.92155 11.93456 11.94776 11.96119 11.97485 11.98874 12.00288 12.01726
## [385] 12.03189 12.04679 12.06195 12.07738 12.09309 12.10908 12.12537 12.14194
## [393] 12.15883 12.17601 12.19352 12.21134 12.22949 12.24797 12.26679 12.28592
## [401] 12.30534 12.32505 12.34504 12.36531 12.38587 12.40672 12.42784 12.44926
## [409] 12.47095 12.49293 12.51519 12.53773 12.56055 12.58366 12.60704 12.63071
## [417] 12.65466 12.67888 12.70339 12.72817 12.75323 12.77858 12.80418 12.83003
## [425] 12.85614 12.88250 12.90912 12.93600 12.96313 12.99053 13.01819 13.04611
## [433] 13.07431 13.10277 13.13150 13.16051 13.18979 13.21934 13.24918 13.27929
## [441] 13.30969 13.34037 13.37133#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log10 SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 443)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 11.87219 11.87147 11.87077 11.87008 11.86941 11.86875 11.86812 11.86751
## [9] 11.86692 11.86635 11.86581 11.86530 11.86482 11.86437 11.86396 11.86357
## [17] 11.86323 11.86292 11.86265 11.86242 11.86224 11.86209 11.86200 11.86195
## [25] 11.86195 11.86200 11.86210 11.86226 11.86247 11.86274 11.86307 11.86346
## [33] 11.86391 11.86443 11.86501 11.86565 11.86637 11.86715 11.86801 11.86894
## [41] 11.86994 11.87103 11.87219 11.87343 11.87475 11.87615 11.87764 11.87921
## [49] 11.88088 11.88263 11.88449 11.88647 11.88857 11.89078 11.89310 11.89552
## [57] 11.89805 11.90068 11.90340 11.90620 11.90910 11.91208 11.91513 11.91826
## [65] 11.92147 11.92473 11.92807 11.93146 11.93490 11.93840 11.94195 11.94554
## [73] 11.94917 11.95283 11.95653 11.96026 11.96401 11.96778 11.97157 11.97537
## [81] 11.97918 11.98300 11.98681 11.99063 11.99444 11.99824 12.00202 12.00579
## [89] 12.00953 12.01325 12.01695 12.02060 12.02422 12.02780 12.03134 12.03482
## [97] 12.03826 12.04164 12.04495 12.04833 12.05188 12.05559 12.05946 12.06347
## [105] 12.06762 12.07190 12.07629 12.08079 12.08539 12.09008 12.09485 12.09969
## [113] 12.10460 12.10955 12.11455 12.11958 12.12464 12.12971 12.13479 12.13987
## [121] 12.14493 12.14997 12.15498 12.15995 12.16488 12.16974 12.17453 12.17925
## [129] 12.18388 12.18841 12.19284 12.19715 12.20134 12.20540 12.20932 12.21390
## [137] 12.21989 12.22713 12.23548 12.24480 12.25494 12.26575 12.27710 12.28884
## [145] 12.30082 12.31290 12.32493 12.33678 12.34829 12.35933 12.36974 12.37939
## [153] 12.38813 12.39581 12.40230 12.40744 12.41242 12.41849 12.42556 12.43356
## [161] 12.44241 12.45203 12.46235 12.47328 12.48476 12.49670 12.50903 12.52168
## [169] 12.53455 12.54759 12.56070 12.57382 12.58687 12.59976 12.61243 12.62479
## [177] 12.63678 12.64830 12.65929 12.66967 12.67936 12.68828 12.69637 12.70353
## [185] 12.70969 12.71479 12.71873 12.72144 12.72285 12.72285 12.72146 12.71877
## [193] 12.71489 12.70992 12.70396 12.69713 12.68952 12.68123 12.67238 12.66305
## [201] 12.65336 12.64341 12.63330 12.62314 12.61302 12.60306 12.59335 12.58400
## [209] 12.57511 12.56679 12.55913 12.55224 12.54483 12.53562 12.52473 12.51230
## [217] 12.49845 12.48332 12.46703 12.44972 12.43151 12.41254 12.39293 12.37282
## [225] 12.35232 12.33159 12.31073 12.28989 12.26919 12.24876 12.22873 12.20924
## [233] 12.19040 12.17236 12.15524 12.13917 12.12427 12.11069 12.09725 12.08275
## [241] 12.06731 12.05104 12.03403 12.01639 11.99824 11.97967 11.96080 11.94173
## [249] 11.92256 11.90341 11.88437 11.86556 11.84708 11.82904 11.81154 11.79469
## [257] 11.77860 11.76337 11.74911 11.73509 11.72054 11.70553 11.69013 11.67439
## [265] 11.65838 11.64216 11.62579 11.60934 11.59287 11.57644 11.56012 11.54396
## [273] 11.52804 11.51241 11.49714 11.48229 11.46793 11.45411 11.44089 11.42835
## [281] 11.41655 11.40554 11.39506 11.38477 11.37469 11.36482 11.35517 11.34573
## [289] 11.33652 11.32755 11.31880 11.31030 11.30204 11.29404 11.28628 11.27879
## [297] 11.27156 11.26461 11.25792 11.25152 11.24540 11.23957 11.23403 11.22855
## [305] 11.22292 11.21716 11.21132 11.20543 11.19953 11.19364 11.18782 11.18208
## [313] 11.17648 11.17104 11.16580 11.16079 11.15606 11.15163 11.14754 11.14383
## [321] 11.14054 11.13769 11.13533 11.13349 11.13221 11.13152 11.13145 11.13205
## [329] 11.13335 11.13507 11.13693 11.13895 11.14113 11.14349 11.14606 11.14884
## [337] 11.15184 11.15509 11.15860 11.16238 11.16645 11.17083 11.17552 11.18055
## [345] 11.18593 11.19168 11.19780 11.20432 11.21124 11.21860 11.22637 11.23452
## [353] 11.24306 11.25197 11.26125 11.27087 11.28084 11.29115 11.30177 11.31272
## [361] 11.32397 11.33551 11.34734 11.35945 11.37183 11.38447 11.39736 11.41049
## [369] 11.42384 11.43742 11.45122 11.46521 11.47940 11.49377 11.50832 11.52303
## [377] 11.53790 11.55291 11.56814 11.58364 11.59941 11.61547 11.63179 11.64839
## [385] 11.66526 11.68240 11.69981 11.71749 11.73544 11.75365 11.77212 11.79086
## [393] 11.80986 11.82913 11.84865 11.86843 11.88847 11.90877 11.92932 11.95014
## [401] 11.97123 11.99260 12.01424 12.03615 12.05834 12.08079 12.10350 12.12649
## [409] 12.14973 12.17324 12.19701 12.22104 12.24532 12.26986 12.29466 12.31971
## [417] 12.34502 12.37057 12.39637 12.42242 12.44871 12.47525 12.50201 12.52895
## [425] 12.55609 12.58343 12.61097 12.63872 12.66669 12.69488 12.72329 12.75194
## [433] 12.78082 12.80994 12.83931 12.86893 12.89881 12.92895 12.95936 12.99004
## [441] 13.02099 13.05224 13.08376#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log10 SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")